home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / cat / searchme.i < prev    next >
Text File  |  1997-10-26  |  12KB  |  402 lines
  1. IMPLEMENTATION MODULE SearchMenu;
  2. (*$R-,S-*)
  3.  
  4. (************************************************************************)
  5. (*                                                                      *)
  6. (*      MenuSearch - Prozedur in Megamax-Modula-2                       *)
  7. (*              von     Dirk Steins                                     *)
  8. (*                      Auf dem Feldchen 48                             *)
  9. (*                      5216 Niederkassel-6                             *)
  10. (*                                                                      *)
  11. (*      Original in C (Zeeh) in ST-Computer 11/89 von Urs Mller        *)
  12. (*                                                                      *)
  13. (*      Ist halt bersetzt aus C, deshalb teilweise nicht sehr          *)
  14. (*      sch”n zu lesen.                                                 *)
  15. (*                                                                      *)
  16. (************************************************************************)
  17.  
  18. FROM SYSTEM         IMPORT ADDRESS, ADR, BYTE;
  19.  
  20. IMPORT MagicAES;
  21. IMPORT MagicXBIOS;
  22. IMPORT MagicStrings;
  23. IMPORT mtAppl;
  24.  
  25. FROM GEMGlobals     IMPORT  PtrObjTree, SpecialKey, SpecialKeySet,
  26.                             GemChar, OStateSet, ObjState, ObjType,
  27.                             PtrMaxStr;
  28. (*
  29. FROM ObjHandler     IMPORT  SetCurrObjTree, ObjectState, ObjectType;
  30. *)
  31. (* Erweiterung fr TDI: ein paar Funktionen aus ObjHandler *)
  32. MODULE ObjcHandler;
  33.  
  34. IMPORT OStateSet, ObjState, ObjType, PtrObjTree;
  35.  
  36. EXPORT  SetCurrObjTree, ObjectState, ObjectType;
  37.  
  38. (*
  39. TYPE    ObjType         = (boxObj, textObj, boxTextObj, imageObj, progDefObj,
  40.                            iBoxObj, buttonObj, boxCharObj, stringObj, fTextObj,
  41.                            fBoxTextObj, iconObj, titleObj);
  42.  
  43.         ObjState        = (selectObj, crossObj, checkObj, disableObj,
  44.                            outlineObj, shadowObj);
  45.         
  46.         OStateSet       = SET OF ObjState;
  47. *)
  48. VAR     currTree : PtrObjTree;
  49.         treeErr : BOOLEAN;
  50.  
  51. PROCEDURE SetCurrObjTree (tree : PtrObjTree);
  52.         (*  Setzt aktuellen Objektbaum *)
  53. BEGIN
  54.   currTree := tree;
  55.   IF tree = NIL
  56.   THEN
  57.     treeErr := TRUE
  58.   ELSE
  59.     treeErr := FALSE
  60.   END;
  61. END SetCurrObjTree;
  62.  
  63. PROCEDURE ObjectState (obj: CARDINAL): OStateSet;
  64.         (*  Liefert den Objektstatus des Objektes 'obj'.
  65.          *)
  66. BEGIN
  67.   IF currTree = NIL
  68.   THEN
  69.     treeErr := TRUE;
  70.     RETURN OStateSet{};
  71.   ELSE
  72.     RETURN OStateSet(currTree^[obj].state);
  73.   END;
  74. END ObjectState;
  75.  
  76. PROCEDURE ObjectType (obj: CARDINAL): ObjType;
  77.         (*  Liefert Objekttyp des Objektes 'obj'.
  78.          *)
  79. BEGIN
  80.   IF currTree = NIL
  81.   THEN
  82.     treeErr := TRUE;
  83.     RETURN boxObj;
  84.   ELSE
  85.     RETURN ObjType(currTree^[obj].type-20);
  86.   END;
  87. END ObjectType;
  88.  
  89. BEGIN
  90.   treeErr := FALSE;
  91. END ObjcHandler;
  92. (* *)
  93.  
  94. VAR   keyTable: MagicXBIOS.PtrKEYTAB;
  95.       Unshift,
  96.       Shift,
  97.       CapsLock : MagicXBIOS.Keycode;
  98.  
  99. TYPE charSet = SET OF CHAR;
  100.  
  101. VAR ctrlSet, altSet, normalSet : charSet;
  102.     where     : ARRAY[0..80] OF RECORD char : CHAR; shiftCode : CARDINAL; entry, title : CARDINAL; END;
  103.     nextWhere : CARDINAL;
  104.     checkIt   : BOOLEAN;
  105.  
  106.  
  107. (* TestEntry testet einen String ab, ob darin eine der untersttzen     *)
  108. (* Tastenkombinationen enthalten ist.                                   *)
  109. (* str: der zu untersuchende String                                     *)
  110. (* ch : ASCII und Scan-Code der gedrckten Taste                        *)
  111. (* state : Tastatur-Status                                              *)
  112.  
  113. PROCEDURE TestEntry (str : PtrMaxStr; entry, title : CARDINAL);
  114.   
  115.   CONST
  116.       (* noch nicht untersttzte Tasten *)
  117.       clrHome = BYTE (71);    (*  <Clr>-Taste  *)
  118.       delete  = BYTE (83);    (*  <Delete>-Taste  *)
  119.       help    = BYTE (98);    (*  <Help>-Taste  *)
  120.       escape  = BYTE (1);     (*  <Esc>-Taste  *)
  121.       
  122.       (* untersttzte Tasten *)
  123.       F1    = 03bH;   (* Scan-Codes der Funktionstasten *)
  124.       F10   = 044H;
  125.       F11   = 054H;
  126.       F20   = 05dH;
  127.   TYPE  CharSet = SET OF CHAR;
  128.   CONST compSet    = CharSet{'A'..'Z','ž',"'",'#',',','.','-','+','*','/'};
  129.  
  130.   VAR compChar : CHAR;
  131.       idx   : INTEGER;
  132.       zahl  : INTEGER;
  133. BEGIN
  134.   idx := MagicStrings.Length (str^)-1;              (* index auf L„nge des Eintrags *)
  135.   WHILE str^[idx]=' ' DO DEC(idx) END; (* Space am Ende ignorieren     *)
  136.   compChar := CAP(str^[idx]);          (* nur Grožbuchstaben           *)
  137.  
  138.   IF (* (compChar >= 'A') & (compChar <= 'Z') *) compChar IN compSet THEN
  139.     (* Test auf Control-Buchstabe oder Alt-Buchstabe *)
  140.     DEC(idx);
  141.     IF str^[idx]='^' THEN
  142.       INCL(ctrlSet, compChar);
  143.       where[nextWhere].char      := compChar;
  144.       where[nextWhere].shiftCode := MagicAES.KCTRL;
  145.       where[nextWhere].entry     := entry;
  146.       where[nextWhere].title     := title;
  147.       INC(nextWhere);
  148.       RETURN
  149.     END;
  150.     IF ORD(str^[idx])=7 THEN
  151.       INCL(altSet, compChar);
  152.       where[nextWhere].char      := compChar;
  153.       where[nextWhere].shiftCode := MagicAES.KALT;
  154.       where[nextWhere].entry     := entry;
  155.       where[nextWhere].title     := title;
  156.       INC(nextWhere);
  157.       RETURN
  158.     END;
  159.        (* FullBox-Zeichen fr Alternate *)
  160. (* Normale Buchstaben auch ersma nich *)
  161.   ELSIF (str^[idx]="'") THEN
  162.     (* Test auf Buchstabe in Hochkommata *)
  163.     DEC(idx);
  164.     compChar := CAP(str^[idx]);
  165.     IF (compChar >= 'A') & (compChar <= 'Z') & (str^[idx-1] = "'") THEN
  166.       INCL(normalSet, compChar);
  167.       where[nextWhere].char      := compChar;
  168.       where[nextWhere].shiftCode := 0FFFFH;
  169.       where[nextWhere].entry     := entry;
  170.       where[nextWhere].title     := title;
  171.       INC(nextWhere);
  172.       RETURN
  173.     END;
  174. (* -- *)
  175.   END;
  176. (* Funktionstasten fallen erstmal weg..
  177.  
  178.   ELSIF (str^[idx]>='0') & (str^[idx]<='9')
  179.   THEN
  180.     (* Test auf Funktionstaste *)
  181.     zahl := ORD(str^[idx])-ORD('0');       (* Wandeln CHAR -> INT *)
  182.     DEC(idx);
  183.     IF (str^[idx]>='0') & (str^[idx]<='9')     (* Buchstabe ist Zahl ? *)
  184.     THEN
  185.       zahl := zahl + INTEGER(10*(ORD(str^[idx])-ORD('0')));
  186.       DEC (idx);
  187.     END (* IF str^[idx]= ... *);
  188.     IF (str^[idx]='F')
  189.     THEN
  190.       IF ((ORD(str^[idx-1])=1) OR (str^[idx-1]='S')) (* Shift - Zeichen *)
  191.       THEN
  192.         INC(zahl, 10);                  (* geschiftet + 10 *)
  193.       END (* IF ORD(...)=1 *);
  194.       IF (zahl >=1) & (zahl <= 10)
  195.       THEN
  196.         IF (zahl = INTEGER(chr.scan) - F1 + 1)
  197.         THEN
  198.           RETURN TRUE
  199.         END (* IF zahl = ... *);
  200.       END;
  201.       IF (zahl >=11) & (zahl <= 20)
  202.       THEN
  203.         IF (zahl = INTEGER(chr.scan) - F11 + 11)
  204.         THEN
  205.           RETURN TRUE
  206.         END (* IF zahl = ... *);
  207.       END (* zahl >= ... *)
  208.     END (* IF ..='F' *);
  209.   END (* IF compChar= chr.ascii *);
  210.   RETURN FALSE
  211. *)
  212. END TestEntry;
  213.  
  214. PROCEDURE CheckMenu( mTree : PtrObjTree );
  215. (* Testet den ganzen Menbaum und setzt entsprechend die Bits in ctrlSet, altSet,
  216.    normalSet; Sowie Funktionstasten (irgendwann mal) *)
  217. VAR doQuit  : BOOLEAN;
  218.     desk    : BOOLEAN;
  219.  
  220.     motherTitle,
  221.     childTitle,
  222.     motherEntry,
  223.     childEntry  : CARDINAL;
  224.  
  225. BEGIN
  226. (* die n„chsten drei fr schnellen Test *)
  227.   ctrlSet   := charSet{};
  228.   altSet    := charSet{};
  229. (*  normalSet := charSet{}; *)
  230.   nextWhere := 0;
  231.  
  232.   doQuit := FALSE;
  233.   desk   := TRUE;
  234.  
  235.   (* Auf geht's in die Objekt-B„ume *)
  236.   (* Bin mir nicht sicher, ob ich den Zeh-Code hier richtig verstanden *)
  237.   (* habe, aber es funktioniert!                                       *)
  238.   
  239.   motherTitle := mTree^[mTree^[0].head].head;
  240.   childTitle := mTree^[motherTitle].head;
  241.   motherEntry := mTree^[mTree^[0].tail].head;
  242.   childEntry := mTree^[motherEntry].head;
  243.  
  244.   SetCurrObjTree(mTree);
  245.  
  246.   WHILE ~doQuit DO
  247.     (* Title Loop *)
  248.     WHILE ~doQuit & (childEntry # motherEntry) & (childEntry # 0FFFFH) DO
  249.       IF (* ~(disableObj IN ObjectState(childEntry)) & *)
  250.          ((ObjectType(childEntry)=buttonObj) OR
  251.           (ObjectType(childEntry)=stringObj))
  252.       THEN
  253.         (* Objekt ist String oder Button, also Eintrag prfen. *)
  254.         TestEntry ( PtrMaxStr(mTree^[childEntry].spec), childEntry, childTitle);
  255.       END;
  256.  
  257.       childEntry := mTree^[childEntry].next;
  258.       IF desk
  259.       THEN
  260.       (* desk ist ein guter Trick: Es wird erst der Info-Eintrag geprft,
  261.          dann jedoch direkt das n„chste Menu genommen und die ACC's damit
  262.          bergangen. (ist nicht von mir)
  263.       *)
  264.         childEntry := motherEntry;
  265.         desk := FALSE;
  266.       END;
  267.     END; (* WHILE ~doQuit & (childEntry # motherEntry) & ... *)
  268.  
  269.     (* n„chsten Eintrag nehmen *)
  270.     childTitle := mTree^[childTitle].next;
  271.     motherEntry := mTree^[motherEntry].next;
  272.     childEntry := mTree^[motherEntry].head;
  273.     IF childTitle = motherTitle
  274.     THEN
  275.       (* Menu komplett abgehandelt *)
  276.       doQuit := TRUE;
  277.     END;
  278.   END (* WHILE ~doQuit *);
  279.   (*
  280.    * WHILE doQuit ist eigentlich berflssig, da die Routine sowieso
  281.    * vorher verlassen wird.
  282.    *)
  283. END CheckMenu;
  284.  
  285. PROCEDURE MenuSearch ( YmTree : ADDRESS; YapId : INTEGER;
  286.                        kstate : BITSET; Ykey : INTEGER;
  287.                        hdlMenu : menuProc;
  288.                        showMouse : BOOLEAN) : BOOLEAN;
  289.  
  290.    TYPE trick = RECORD CASE : BOOLEAN OF
  291.                     TRUE : key : INTEGER|
  292.                    FALSE : scan : BYTE;
  293.                            ascii: CHAR;
  294.                   END;
  295.                 END;
  296.       
  297.   VAR mTree : PtrObjTree;
  298.       apId : CARDINAL; key : GemChar;
  299.       msgBuff : ARRAY [0..7] OF CARDINAL;
  300.       chr     : GemChar;
  301.       state   : SpecialKeySet;
  302.       scan    : CARDINAL;
  303.       voidL   : LONGINT;
  304.       z       : CARDINAL;
  305.       found   : BOOLEAN;
  306.       CompareState : CARDINAL;
  307.       t       : trick;
  308. BEGIN
  309. (* neu *)
  310.   mTree := PtrObjTree(YmTree); apId := CARDINAL(YapId); t.key := Ykey;
  311.   key.scan := t.scan; key.ascii := t.ascii;
  312. (* --- *)
  313.   IF checkIt THEN (* Beim ersten mal checken *)
  314.     CheckMenu(mTree);
  315.     checkIt := FALSE;
  316.  
  317.     (* Adressen der Tastaturtabellen holen *)
  318.     voidL := -1;
  319.     Unshift := MagicXBIOS.Keycode(voidL);
  320.     Shift   := MagicXBIOS.Keycode(voidL);
  321.     CapsLock:= MagicXBIOS.Keycode(voidL);
  322.     keyTable := MagicXBIOS.Keytbl(Unshift, Shift, CapsLock);
  323.     WITH keyTable^ DO
  324.       Unshift := unshift;
  325.       Shift   := shift;
  326.       CapsLock:= capslock;
  327.     END;
  328.     (*
  329.     MagicXBIOS.Bioskeys();
  330.     *)
  331.   END;
  332.  
  333. (*
  334.   (* Warten bis Drop-Down's geschlossen *)
  335.   MagicAES.WindUpdate(MagicAES.BEGUPDATE);
  336.   MagicAES.WindUpdate(MagicAES.ENDUPDATE);
  337. *)
  338.   
  339.   (* ASCII - Wert selbst bestimmen, da kein Verlaž auf GEM *)
  340.   (* CapsLock wird ignoriert *)
  341.   IF (MagicAES.KLSHIFT IN kstate) OR (MagicAES.KRSHIFT IN kstate)
  342.   THEN
  343.     (* Shift-gedrckt, geshiftete Tabelle nehmen *)
  344.     chr.ascii := CHAR (Shift^[CARDINAL(LONG(key.scan))]);
  345.   ELSE
  346.     (* nicht geschiftet *)
  347.     chr.ascii := CHAR (Unshift^[CARDINAL(LONG(key.scan))]);
  348.   END;
  349.   chr.ascii := CAP(chr.ascii);
  350.   chr.scan := key.scan;
  351.    
  352.   IF (MagicAES.KALT IN kstate) & (MagicAES.KCTRL IN kstate)
  353.   THEN
  354.     (* Beides ist nicht m”glich *)
  355.     RETURN FALSE
  356.   END;
  357.  
  358.   IF MagicAES.KALT IN kstate THEN
  359.     IF chr.ascii IN altSet THEN
  360.       CompareState := MagicAES.KALT
  361.     ELSE
  362.       RETURN FALSE
  363.     END;
  364.   ELSIF MagicAES.KCTRL IN kstate THEN
  365.     IF chr.ascii IN ctrlSet THEN
  366.       CompareState := MagicAES.KCTRL
  367.     ELSE
  368.       RETURN FALSE
  369.     END;
  370.   ELSE
  371.     RETURN FALSE
  372.   END;
  373.  
  374.   z := 0;
  375.   WHILE (z < nextWhere) &
  376.         ((where[z].char # chr.ascii) OR (where[z].shiftCode # CompareState)) DO
  377.     INC(z);
  378.   END;
  379.  
  380.   SetCurrObjTree(mTree);
  381.  
  382.   (* Jetzt muž er gefunden worden sein!, naja trotzdem: *)
  383.   IF (where[z].char # chr.ascii) OR (where[z].shiftCode # CompareState) OR
  384.      (disableObj IN ObjectState(where[z].entry)) OR
  385.      (disableObj IN ObjectState(where[z].title)) THEN
  386.     RETURN FALSE
  387.   END;
  388.  
  389.   (* Menu invertieren *)
  390.   MagicAES.MenuTnormal (mTree, where[z].title, 0);
  391.  
  392.   IF showMouse THEN
  393.     mtAppl.MouseOn;
  394.   END;
  395.   hdlMenu(CARDINAL(where[z].entry), CARDINAL(where[z].title), kstate);
  396.   RETURN TRUE        (* das wars *)
  397. END MenuSearch;
  398.  
  399. BEGIN
  400.   checkIt := TRUE;
  401. END SearchMenu.
  402.